home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
fieldent.zip
/
FIELDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
5KB
|
145 lines
{$V-}
Program Fieldemo;
(* 05/02/1988 J Tal
Rollins Medical/Dental Systems
Public Domain
*)
Uses
Crt,Funcs,DosBios,Fields;
VAR
vMode,
scr_type: Integer;
colf : IntAry25;
cols : StrAry25;
Intens : StrAry4;
Ed_cur_str,
Ed_nor_str,
Ed_err_str,
Ed_scr_str : st255;
scrd,
scrf: StrAry4;
slim,
flen,
ii,iii,
cursor_field : Integer;
yn_str,
buff_str: st255;
i,w,x,y,text_color,text_bak: Integer;
disp_color: Byte;
cmnd_str: st255;
Procedure InitFields;
(* Sample col variable initialization *)
BEGIN
Case Scr_Type OF
MonoChrome: begin
colf[fore,0] := 7; colf[back,0] := 0; (* Main Text foreground background *)
colf[fore,1] := 1; colf[back,1] := 0; (* Editable field passive colors *)
colf[fore,2] := 0; colf[back,2] := 7; (* Editable field active colors *)
colf[fore,3] := 0; colf[back,3] := 7; (* Editable field in error (reversed) *)
colf[fore,4] := 0; colf[back,4] := 7; (* Main Text in reverse *)
end;
BlackWhite: begin
colf[fore,0] := 7; colf[back,0] := 0;
colf[fore,1] := 14; colf[back,1] := 2;
colf[fore,2] := 0; colf[back,2] := 7;
colf[fore,3] := 14; colf[back,3] := 7;
colf[fore,4] := 0; colf[back,4] := 7;
end;
Color: begin
colf[fore,0] := 7; colf[back,0] := 0;
colf[fore,1] := 0; colf[back,1] := 3;
colf[fore,2] := 1; colf[back,2] := 7;
colf[fore,3] := 7; colf[back,3] := 4;
colf[fore,4] := 7; colf[back,4] := 1;
end;
else
end;
END;
BEGIN
vMode := Get_Vmode;
IF vMode = 7 THEN
scr_type := MonoChrome
ELSE begin
Write('Is you monitor able to display more than 2 colors? (y/n)');
ReadLn(yn_str);
IF Upcase(yn_str[1]) = 'Y' THEN
scr_type := Color
ELSE
scr_type := BlackWhite;
END;
InitFields;
ClrScr;
Gotoxy(1,20); Writeln('<Tab> = next field <Sh-Tab> = prev field <Esc> = erase to end <Ret> = end');
(* assign colf colors to Ed_xxx_str's *)
SetIoCol(scr_type,colf,cols,Intens,Ed_cur_Str,Ed_nor_str,Ed_err_str,Ed_scr_str);
(* initialize input fields and draw field labels *)
GotoXY(21,8); WriteLn('Field 1'); scrf[1] := '08,30,C 50,' + Ed_nor_str;
GotoXY(21,10); WriteLn('Field 2'); scrf[2] := '10,30,C 10,' + Ed_nor_str;
GotoXY(21,12); WriteLn('Field 3'); scrf[3] := '12,30,C 20,' + Ed_nor_str;
GotoXY(21,14); WriteLn('Field 4'); scrf[4] := '14,30,C 02,' + Ed_nor_str;
slim := 4;
(* blank out fields, could be existing data from file *)
FOR i := 1 TO slim DO begin
w := fnval(Copy(scrf[i],9,2));
scrd[i] := spaces(w);
END;
(* output fields *)
FOR i := 1 TO slim DO begin
field_out(scr_type,colf[fore,0],colf[back,0],scrf[i],scrd[i]);
(* optional long-hand way to display data fields
x := fnval(Copy(scrf[i],4,2));
y := fnval(Copy(scrf[i],1,2));
FigScreenAttrib(scr_type,Copy(scrf[i],12,2),Copy(scrf[i],15,2),text_color,text_bak,disp_color);
Textcolor(text_color);
Textbackground(text_bak);
GotoXY(x,y);
WriteLn(scrd[i]);
*)
END;
TextColor(colf[fore,0]);
TextBackground(colf[back,0]);
cursor_field := 1;
ii := cursor_field;
(* interactive editing begins, ii is control variable *)
WHILE ii > -2 DO begin (* while return not pressed *)
cmnd_str := copy(scrf[ii],1,11) + Ed_cur_str; (* current field *)
iii := ii; (* remember ii in iii cause ii changes *)
buff_str := scrd[iii]; (* starting input is field's current contents *)
field_in(scr_type,colf[fore,0],colf[back,0],cmnd_str,buff_str,flen,ii); (* field editing *)
scrd[iii] := buff_str; (* edited *)
cmnd_str := copy(scrf[iii],1,11) + Ed_nor_str; (* restore field to orig state *)
field_out(scr_type,colf[fore,0],colf[back,0],cmnd_str,buff_str);
if ii > slim then ii := 1; (* tab goes to next field, if at end wrap to top *)
if ii = 0 then ii := slim; (* shift-tab goes to prev field, if at top wrap to bottom *)
END;
END.